安裝套件及載入資料
rm(list=ls(all=TRUE))
options(scipen=10)
pacman::p_load(latex2exp,tidyr,caTools)
pacman::p_load(FactoMineR, factoextra)
pacman::p_load(Matrix, vcd, magrittr, readr, caTools, ggplot2, dplyr)
load("data/tf5.rdata")
B <- B將資料進行第一步的篩選
利用RFM進行顧客的分群,最終選擇六群為最佳分群
## kmg
## 1 2 3 4 5 6
## 7750 1437 5364 3709 13517 464
A0[,c(2,4,5)] %>% PCA(graph=FALSE) %>% fviz_pca_biplot(
col.ind=df$grp,
label="var", pointshape=19, mean.point=F,
addEllipses=T, ellipse.level=0.7,
ellipse.type = "convex", palette="ucscgb",
repel=T
)
透過營收繪製泡泡圖,泡泡大小為族群人數,泡泡顏色越紅其營收越高,而X軸為客單價,Y軸則為平均購買次數
A0 %>% group_by(grp) %>% summarise(
Group.Size = n(), # 族群人數
total.Rev = sum(rev), # 總營收
avg.Freq = mean(f), # 平均購買次數
avg.Revenue = sum(f*m)/sum(f) # 平均客單價
) %>%
ggplot(aes(y=avg.Freq, x=avg.Revenue)) +
geom_point(aes(col=total.Rev, size=Group.Size), alpha=0.5) +
geom_text(aes(label=grp)) +
scale_size(range=c(5,25)) +
scale_color_gradient(low="green",high="red") +
theme_bw() + theme(legend.position="none") +
ggtitle("營收區隔特徵 (泡泡大小:族群人數)") +
ylab("平均購買次數") + xlab("平均客單價")
💡 族群特徵:
※ 族群1(沉睡顧客)
§ 觀察:消費頻率低、消費金額低、許久未進行消費
§ 推論:但由於人數是第二多的族群,如果將其喚醒,將會提升可觀的營業額
※ 族群2(無明顯價值顧客)
§ 觀察:平均購買單價比第二名的族群3高出一倍,但平均購買次數低、前一次來購買的天數也長
§ 推論:一次性顧客,且只為高單價的商品(例如:電器用品、奢侈品等)
※ 族群3(重要發展顧客)
§ 觀察:消費頻率低、消費金額高、最近才剛消費
§ 推論:這類型客戶在最近一筆訂單上花了很多錢,是必須重點式經營的客戶,讓他們再次關注品牌和產品
※ 族群4(忠誠顧客)
§ 觀察:消費頻率高、消費金額中間、最近才剛消費
§ 推論:這類型客戶是品牌最重要的資產,對品牌黏著度高、貢獻的消費額也大,需持續經營並適時刺激會員的消費單價
※ 族群5(一般價值顧客)
§ 觀察:消費頻率低、消費金額中間、最近才剛消費
§ 推論:這類型客戶算是貢獻的主力之一,但各項指標都沒有突出,唯一依靠的便是人數,屬於最大群的顧客,且有一定忠誠度
※ 族群6(無明顯價值顧客)
§ 觀察:平均購買次數比第二名的族群4高出三倍,但平均購買單價低
§ 推論:屬於大眾顧客之中購買必需品、日常消耗品的族群(例如:衛生紙、文具等)
group_by(A0, grp) %>% summarise(mean(r),mean(s),mean(f),sum(rev),mean(m),sum(raw),avg.Revenue = sum(f*m)/sum(f))## # A tibble: 6 x 8
## grp `mean(r)` `mean(s)` `mean(f)` `sum(rev)` `mean(m)` `sum(raw)`
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 86.9 93.5 1.45 8063282 728. 1203904
## 2 2 58.1 77.0 1.68 9788761 4067. 1696096
## 3 3 24.9 71.5 2.70 27502138 1897. 4534400
## 4 4 8.87 110. 10.6 25958981 664. 3851563
## 5 5 20.9 68.4 2.77 21896388 565. 3103042
## 6 6 3.89 117. 31.2 8536787 583. 1257813
## # ... with 1 more variable: avg.Revenue <dbl>
## Joining, by = c("cust", "Buy")
## # A tibble: 6 x 2
## grp avg.Buy
## <fct> <dbl>
## 1 1 0.293
## 2 2 0.315
## 3 3 0.494
## 4 4 0.939
## 5 5 0.525
## 6 6 0.999
grp1 <- subset(A0,grp == "1")
grp2 <- subset(A0,grp == "2")
grp3 <- subset(A0,grp == "3")
grp4 <- subset(A0,grp == "4")
grp5 <- subset(A0,grp == "5")
💡 行銷方案:
此群顧客群已成沉睡顧客,因此就發放優惠券希望把握他們還會來的機會
個別成本NT$30
預期收入NT$25,860
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.25, b=21.5, a=43.5), 0, 50, lwd=2, ylim=c(0, 0.25),
main="F( x | m=0.25, b=21.5, a=43.5 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.25; b=21.5; a=43.5; x=30; margin = 0.2
dp = DP(x,m,b,a)
dp = ifelse(grp1$Buy+dp>1, 1-grp1$Buy, dp)
eR = dp*grp1$Rev*margin - x
hist(eR)m=0.25; b=21.5; a=43.5; X = seq(0,100,1) ; margin = 0.2
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp1$Buy+dp>1, 1-grp1$Buy, dp)
eR = dp*grp1$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> r
sum(eR) #25,860## [1] 25860.59
💡 行銷方案:
預計花費約27萬邀請小網紅拍攝開箱文及發佈業配文,希望在他的頻道或社群軟體進行宣傳
個別成本NT$50
預期收入NT$175,152
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.25, b=37, a=50.5), 10, 80, lwd=2, ylim=c(0, 0.25),
main="F( x | m=0.25, b=37, a=50.5)", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.25; b=37; a=50.5; x=50 ; margin = 0.25
dp = DP(x,m,b,a)
dp = ifelse(grp3$Buy+dp>1, 1-grp3$Buy, dp)
eR = dp*grp3$Rev*margin - x
hist(eR)## [1] 175152.3
m=0.25; b=37; a=50.5; X = seq(0,200,1); margin = 0.25
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp3$Buy+dp>1, 1-grp3$Buy, dp)
eR = dp*grp3$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> y
sum(eR) #175,152## [1] 175152.3
💡 行銷方案:
預計裝潢店鋪費用為25萬元,透過新的裝潢創造新鮮感,吸引顧客前來消費
個別成本NT$48
預期收入NT$122,790
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.275, b=35, a=55), 0, 80, lwd=2, ylim=c(0, 0.3),
main="F( x | m=0.275, b=35, a=55)", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.275; b=35; a=55; x=48 ; margin = 0.2
dp = DP(x,m,b,a)
dp = ifelse(grp3$Buy+dp>1, 1-grp3$Buy, dp)
eR = dp*grp3$Rev*margin - x
hist(eR)## [1] 122790.2
m=0.275; b=35; a=55; X = seq(0,200,1); margin = 0.2
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp3$Buy+dp>1, 1-grp3$Buy, dp)
eR = dp*grp3$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> y
sum(eR) #122,790## [1] 122790.2
💡 行銷方案:
在app推播線上團購僅需些許人力成本及網站維護攤銷費用(低成本)
個別成本NT$10
預期收入NT$28,542
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.3,b=10,a=20), 0, 30, lwd=2, ylim=c(0, 0.35),
main="F( x | m=0.3, b=10, a=20 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.3; b=10; a=20; x=10 ; margin = 0.25
dp = DP(x,m,b,a)
dp = ifelse(grp4$Buy+dp>1, 1-grp4$Buy, dp)
eR = dp*grp4$Rev*margin - x
hist(eR)m=0.3; b=10; a=20; X = seq(0,100,1) ; margin = 0.25
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp4$Buy+dp>1, 1-grp4$Buy, dp)
eR = dp*grp4$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> q
sum(eR) #28,542## [1] 28542.56
💡 行銷方案:
集滿五點就發放贈品,贈品採大量批購(壓低成本)ex.當季零食組合包、襪子、輕便帆布
個別成本NT$46
預期收入NT$126,839
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.4,b=35,a=140), 0, 120, lwd=2, ylim=c(0, 0.4),
main="F( x | m=0.4, b=35, a=140 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.4; b=35; a=140; x=46; margin = 0.3
dp = DP(x,m,b,a)
dp = ifelse(grp5$Buy+dp>1, 1-grp5$Buy, dp)
eR = dp*grp5$Rev*margin - x
hist(eR)m=0.4; b=35; a=140; X = seq(0,150,1); margin = 0.3
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp5$Buy+dp>1, 1-grp5$Buy, dp)
eR = dp*grp5$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> p
sum(eR) #126,839## [1] 126839.4
💡 行銷方案:
5公里內來回油錢
個別成本NT$26
預期收入NT$63,280
DP = function(x,m0,b0,a0) {m0*plogis((10/a0)*(x-b0))}
par(mar=c(4,4,2,1),mfrow=c(1,2),cex=0.7)
curve(DP(x,m=0.25,b=20,a=30), 0, 40, lwd=2, ylim=c(0, 0.3),
main="F( x | m=0.25, b=20, a=30 )", ylab="delta P")
abline(h=seq(0,0.2,0.05),v=seq(0,30,5),col='lightgrey',lty=2)
m=0.25; b=20; a=30; x=26; margin = 0.2
dp = DP(x,m,b,a)
dp = ifelse(grp5$Buy+dp>1, 1-grp5$Buy, dp)
eR = dp*grp5$Rev*margin - x
hist(eR)m=0.25; b=20; a=30; X = seq(0,100,1); margin = 0.2
sapply(X, function(x) {
dp = DP(x,m,b,a)
dp = ifelse(grp5$Buy+dp>1, 1-grp5$Buy, dp)
eR = dp*grp5$Rev*margin - x
c(x=x, eReturn=sum(eR), N=sum(eR > 0))
}) %>% t %>% data.frame %>%
gather('key','value',-x) %>%
ggplot(aes(x=x, y=value, col=key)) +
geom_hline(yintercept=0,linetype='dashed') +
geom_line(size=1.5,alpha=0.5) +
facet_wrap(~key,ncol=1,scales='free_y') + theme_bw() -> s
sum(eR) #63,280## [1] 63280.1